home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d12 / v9n04.arc / CARDS.PAS < prev    next >
Pascal/Delphi Source File  |  1990-01-30  |  19KB  |  670 lines
  1. UNIT Cards;
  2. (**********************)
  3. (**)   INTERFACE    (**)
  4. (**********************)
  5.  
  6. USES crt, ListObj;
  7. CONST pips : array[0..12] of char = 'A23456789TJQK';
  8.      suits : array[0..3] of char = (#3, #4, #5, #6);
  9. TYPE
  10.   CardP     = ^Card;
  11.   LCardP    = ^LCard;
  12.   PileP     = ^Pile;
  13.   DeckP     = ^Deck;
  14.   LDeckP    = ^LDeck;
  15.   HandP     = ^Hand;
  16.   PlayerP   = ^Player;
  17.   direction = (up, dn, lt, rt);
  18.   decision  = (no, yes, maybe);
  19.  
  20.   CARD = OBJECT (Node)
  21.     value, X, Y           : Word;
  22.     HoldAttr, TableColor,
  23.     PipColor              : Byte;
  24.     FaceUp                : Boolean;
  25.     CONSTRUCTOR Init(iValue : Word; iTC : Byte; iFaceUp : boolean);
  26.     CONSTRUCTOR InitXY(iValue, iX, iY : word;
  27.                        iTC : Byte; iFaceUp : boolean);
  28.     DESTRUCTOR done; virtual;
  29.   {--- next 4 routines locate card at (X, Y) ---}
  30.     PROCEDURE DrawAt(vX, vY : Word); virtual;
  31.     PROCEDURE HideAt(vX, vY : Word); virtual;
  32.     PROCEDURE PointTo(vX, vY : Word; direc : direction); virtual;
  33.     PROCEDURE UnPoint(vX, vY : Word; direc : direction); virtual;
  34.   {--- next 4 routines use card's intrinsic location ---}
  35.     PROCEDURE Display; 
  36.     PROCEDURE hide;
  37.     PROCEDURE PointT(direc : direction); 
  38.     PROCEDURE UnPoin(direc : direction); 
  39.     FUNCTION  GetRank : Byte; virtual;
  40.     FUNCTION  GetSuit : Byte; virtual;
  41.   {--- remaining routines are static ---}
  42.     PROCEDURE TurnUp; 
  43.     PROCEDURE TurnDown; 
  44.     PROCEDURE PutInPlace(iX, iY : Word); 
  45.     FUNCTION  GetValue : Word; 
  46.   END; 
  47.  
  48.   LCard = OBJECT (Card)
  49.   {--- Little Card -- differs only in how it's displayed ---}
  50.     CONSTRUCTOR Init(iValue : Word; iTC : Byte; iFaceUP : boolean); 
  51.     CONSTRUCTOR InitXY(iValue, iX, iY : word; 
  52.                        iTC : Byte; iFaceUp : boolean); 
  53.     DESTRUCTOR Done; virtual;
  54.     PROCEDURE DrawAt(vX, vY : Word); virtual;
  55.     PROCEDURE HideAt(vX, vY : Word); virtual;
  56.   END; 
  57.  
  58.   Pile = OBJECT (Node)
  59.   {--- a "smart" list of cards ---}
  60.     X, Y, NumInPile : Word;
  61.     FaceUp          : Decision;
  62.     Cards           : List;
  63.     CONSTRUCTOR Init(iX, iY : Word; iShow : Decision);
  64.     DESTRUCTOR Done; virtual;
  65.     PROCEDURE AddCard(C : CardP);
  66.     PROCEDURE Display; virtual;
  67.     PROCEDURE Hide; virtual;
  68.     PROCEDURE Sort(bySuit : boolean); virtual;
  69.   {--- remaining methods are static ---}
  70.     PROCEDURE PlaceAt(iX, iY : Word);
  71.     FUNCTION  OnTop : CardP;
  72.     FUNCTION  OnBot : CardP;
  73.     FUNCTION  FromTop : CardP;
  74.     FUNCTION  FromBot : CardP;
  75.     FUNCTION  NextCard(C : CardP) : CardP;
  76.     FUNCTION  PrevCard(C : CardP) : CardP;
  77.     PROCEDURE Remove(C : CardP);
  78.     FUNCTION  Empty : boolean;
  79.     FUNCTION  GetX : Word;
  80.     FUNCTION  GetY : Word;
  81.     PROCEDURE TurnUp;
  82.     PROCEDURE TurnDown;
  83.     FUNCTION  GetUp : decision;
  84.   END;
  85.  
  86.   Hand = OBJECT (pile)
  87.   {--- a hand is a pile with the cards spread out ---}
  88.     pX, pY  : Byte; {used in pointing to cards}
  89.     direc  : direction; 
  90.     CONSTRUCTOR Init(iX, iY : Word; iShow : decision; 
  91.                      iDire : direction); 
  92.     DESTRUCTOR Done; virtual; 
  93.     PROCEDURE Display; virtual; 
  94.     PROCEDURE Hide; virtual; 
  95.     PROCEDURE PointToCard(CP : CardP; dr : direction); virtual; 
  96.     PROCEDURE UnPointCard(CP : CardP; dr : direction); virtual; 
  97.   {--- remaining method is "private" ---}
  98.     PROCEDURE Private_Go; 
  99.   END; 
  100.  
  101.   DECK = OBJECT (pile)
  102.   {--- a DECK is a PILE that can shuffle ---}
  103.     CONSTRUCTOR Init(iX, iY : Word; iTC : Byte); 
  104.     DESTRUCTOR done; virtual; 
  105.     PROCEDURE shuffle; virtual; 
  106.     PROCEDURE AddToBottom(C : CardP);
  107.   END; 
  108.  
  109.   LDeck = OBJECT (deck)
  110.   {--- a LDECK is a DECK of little cards ---}
  111.     CONSTRUCTOR Init(iX, iY : Word; iTC : Byte); 
  112.     DESTRUCTOR done; virtual; 
  113.   END; 
  114.  
  115.   Player = OBJECT (node)
  116.   {--- abstract -- each GAME needs a new player type ---}
  117.     H    : HandP; 
  118.     name : String; 
  119.     CONSTRUCTOR Init(iX, iY : Word; iShow : decision; 
  120.                 iDire : direction; iName : String);
  121.     DESTRUCTOR Done; virtual; 
  122.     PROCEDURE TakeCard(C : CardP); virtual; 
  123.     PROCEDURE ShowHand; virtual; 
  124.     PROCEDURE PointToMe; virtual; 
  125.     PROCEDURE UnPointMe; virtual; 
  126.   {--- remaining methods are static ---}
  127.     FUNCTION  GetName : String; 
  128.     FUNCTION  OutOfCards : Boolean; 
  129.     FUNCTION  NextNotSelf(L : list; X : PlayerP) : PlayerP; 
  130.     FUNCTION  PrevNotSelf(L : list; X : PlayerP) : PlayerP; 
  131.     FUNCTION  FirsNotSelf(L : List) : PlayerP; 
  132.   END; 
  133.  
  134.   Game = OBJECT
  135.   {--- abstract object -- every game will differ ---}
  136.     D          : deckP;
  137.     TableColor : Byte;
  138.     players    : list;
  139.     whoseturn  : PlayerP;
  140.     CONSTRUCTOR Init(iTC : byte);
  141.     DESTRUCTOR done; virtual;
  142.     PROCEDURE DealCards(num : word); virtual;
  143.     PROCEDURE Display; virtual;
  144.   {--- remaining methods are static ---}
  145.     PROCEDURE AddPlayer(PP : PlayerP);
  146.   END;
  147.  
  148. (*-non-method routines-------*)
  149.  
  150.   PROCEDURE Frame(x1, y1, x2, y2 : byte; {corner coords}
  151.                   typ : byte;         {type of frame}
  152.                   clr : boolean;      {clear inside?}
  153.                   clrch : char);      {clear with what}
  154.  
  155.   PROCEDURE beep;
  156.   PROCEDURE click;
  157.   PROCEDURE sad;
  158.   PROCEDURE happy;
  159.   PROCEDURE fanfare;
  160.  
  161. (**********************)
  162. (**) IMPLEMENTATION (**)
  163. (**********************)
  164.  
  165. (*-non-method routines-------*)
  166.  
  167.   PROCEDURE Frame(x1, y1, x2, y2 : byte; {corner coords}
  168.                   typ : byte;         {type of frame}
  169.                   clr : boolean;      {clear inside?}
  170.                   clrch : char);      {clear with what}
  171.   TYPE fchars = (ulc, top, urc, side, lrc, llc);
  172.   CONST fc : ARRAY[0..2] OF ARRAY[fchars] OF CHAR = 
  173.     ('      ', #218#196#191#179#217#192, 
  174.      #201#205#187#186#188#200); 
  175.   VAR
  176.     ro, co : Byte; 
  177.     S : String[80];
  178.   BEGIN
  179.     FillChar(S, SizeOf(S), fc[typ][top]); 
  180.     S[0] := char(pred(x2-x1));
  181.     GotoXY(x1, y1); 
  182.     Write(fc[typ][ulc], S, fc[typ][urc]); 
  183.     GotoXY(x1, y2); 
  184.     Write(fc[typ][llc], S, fc[typ][lrc]); 
  185.     FillChar(S[1], pred(SizeOf(S)), clrch); 
  186.     FOR ro := succ(y1) TO pred(y2) DO
  187.       IF clr THEN
  188.         BEGIN
  189.           GotoXY(x1, ro);
  190.           Write(fc[typ][side], S, fc[typ][side])
  191.         END
  192.       ELSE
  193.         BEGIN
  194.           GotoXY(x1, ro); Write(fc[typ][side]);
  195.           GotoXY(x2, ro); Write(fc[typ][side]);
  196.         END;
  197.   END;
  198.  
  199.   PROCEDURE SoundDel(S, D : Word); BEGIN Sound(S); Delay(D); END;
  200.  
  201.   PROCEDURE beep; BEGIN SoundDel(3000, 100); nosound; END;
  202.  
  203.   PROCEDURE click; BEGIN SoundDel(4000, 10); NoSound; END;
  204.  
  205.   PROCEDURE sad;
  206.   VAR N : Byte;
  207.   BEGIN
  208.     FOR N := 50 DOWNTO 1 DO SoundDel(500+20*N, 5); NoSound;
  209.   END;
  210.  
  211.   PROCEDURE happy;
  212.   VAR N : Byte;
  213.   BEGIN
  214.     FOR N := 1 TO 50 DO SoundDel(500+30*N, 5); NoSound;
  215.   END;
  216.  
  217.   PROCEDURE fanfare;
  218.   BEGIN
  219.     SoundDel(523, 200); SoundDel(698, 200);
  220.     SoundDel(880, 200); SoundDel(1047, 200);
  221.     NoSound;            Delay(200);
  222.     SoundDel(880, 200); SoundDel(1047, 600);
  223.     NoSound;
  224.   END; 
  225.  
  226. (*-methods for CARD----------*)
  227.  
  228.   CONSTRUCTOR Card.Init(iValue : Word; iTC : Byte; iFaceUp : boolean); 
  229.   BEGIN
  230.     value := iValue; TableColor := iTC;
  231.     IF value < 26 THEN PipColor := LightRed ELSE PipColor := black;
  232.     FaceUp := iFaceUp; X := 0; Y := 0; 
  233.   END; 
  234.  
  235.   CONSTRUCTOR Card.InitXY(iValue, iX, iY : word;
  236.                           iTC : Byte; iFaceUp : boolean);
  237.   BEGIN Init(iValue, iTC, iFaceUp); X := iX; Y := iY; END;
  238.  
  239.   DESTRUCTOR card.done; BEGIN END;
  240.  
  241.   PROCEDURE Card.DrawAt(vX, vY : Word);
  242.   BEGIN
  243.     HoldAttr := TextAttr;
  244.     TextBackground(white);
  245.     IF FaceUP THEN
  246.       BEGIN
  247.         TextColor(PipColor);
  248.         frame(vX, vY, vX+4, vY+4, 1, true, ' ');
  249.         {Write pips across AND down, so card values
  250.          will be visible when spread horz. or vert.}
  251.         GotoXY(vX+1, vY+2); Write(pips[GetRank]);
  252.         GotoXY(vx+2, vY+1); Write(pips[GetRank]);
  253.         GotoXY(vX+1, vY+3); Write(suits[GetSuit]);
  254.         GotoXY(vX+3, vY+1); Write(suits[GetSuit]);
  255.       END
  256.     ELSE
  257.       BEGIN
  258.         TextBackground(blue); TextColor(lightgray);
  259.         frame(vX, vY, vX+4, vY+4, 2, true, #176);
  260.       END;
  261.     TextAttr := HoldAttr;
  262.   END; 
  263.  
  264.   PROCEDURE Card.HideAt(vX, vY : Word); 
  265.   BEGIN
  266.     HoldAttr := TextAttr;
  267.     TextAttr := TableColor;
  268.     frame(vX, vY, vX+4, vY+4, 0, true, ' '); 
  269.     TextAttr := HoldAttr;
  270.   END; 
  271.  
  272.   PROCEDURE Card.PointTo(vX, vY : Word; direc : direction); 
  273.   BEGIN
  274.     HoldAttr := TextAttr;
  275.     TextAttr := TableColor;
  276.     CASE direc OF
  277.       up : BEGIN; GotoXY(vX+1, vY-1); Write(#25); END;
  278.       dn : BEGIN; GotoXY(vX+1, vY+5); Write(#24); END;
  279.       lt : BEGIN; GotoXY(vX-1, vY+2); Write(#26); END;
  280.       rt : BEGIN; GotoXY(vX+5, vY+2); Write(#27); END;
  281.     END;
  282.     TextAttr := HoldAttr;
  283.   END;
  284.  
  285.   PROCEDURE Card.UnPoint(vX, vY : Word; direc : direction);
  286.   BEGIN
  287.     HoldAttr := TextAttr;
  288.     TextAttr := TableColor;
  289.     CASE direc OF
  290.       up : BEGIN; GotoXY(vX+1, vY-1); Write(' '); END;
  291.       dn : BEGIN; GotoXY(vX+1, vY+5); Write(' '); END;
  292.       lt : BEGIN; GotoXY(vX-1, vY+2); Write(' '); END;
  293.       rt : BEGIN; GotoXY(vX+5, vY+2); Write(' '); END;
  294.     END;
  295.     TextAttr := HoldAttr;
  296.   END;
  297.  
  298.   PROCEDURE Card.Display; BEGIN DrawAt(X, Y); END;
  299.  
  300.   PROCEDURE Card.Hide;    BEGIN HideAt(X, Y); END;
  301.  
  302.   PROCEDURE Card.PointT(direc : direction);
  303.   BEGIN PointTo(X, Y, direc); END;
  304.  
  305.   PROCEDURE Card.Unpoin(direc : direction);
  306.   BEGIN UnPoint(X, Y, direc); END;
  307.  
  308.   FUNCTION Card.GetRank : Byte; BEGIN GetRank := value MOD 13; END;
  309.  
  310.   FUNCTION Card.GetSuit : Byte; BEGIN GetSuit := value DIV 13; END;
  311.  
  312.   PROCEDURE Card.TurnUp; BEGIN FaceUp := True; END;
  313.  
  314.   PROCEDURE Card.TurnDown; BEGIN FaceUp := False; END;
  315.  
  316.   PROCEDURE Card.PutInPlace(iX, iY : Word);
  317.   BEGIN X := iX; Y := iY; END;
  318.  
  319.   FUNCTION Card.GetValue : Word; BEGIN GetValue := Value; END;
  320.  
  321. (*-methods for LCard---------*)
  322.  
  323.   CONSTRUCTOR LCard.Init(iValue : Word;
  324.                          iTC : Byte; iFaceUP : boolean);
  325.   BEGIN Card.Init(iValue, iTC, iFaceUp); END;
  326.  
  327.   CONSTRUCTOR LCard.InitXY(iValue, iX, iY : word;
  328.                            iTC : Byte; iFaceUp : boolean);
  329.   BEGIN Init(iValue, iTC, iFaceUp); X := iX; Y := iY; END;
  330.  
  331.   DESTRUCTOR LCard.Done; BEGIN Card.Done; END;
  332.  
  333.   PROCEDURE LCard.DrawAt(vX, vY : Word);
  334.   BEGIN
  335.     HoldAttr := TextAttr;
  336.     TextBackground(White);
  337.     IF FaceUp THEN
  338.       BEGIN
  339.         TextColor(PipColor);
  340.     GotoXY(vX, vY); Write(' ',pips[GetRank],' ');
  341.     GotoXY(vX, succ(vY)); Write(' ',suits[GetSuit],' ');
  342.       END
  343.     ELSE
  344.       BEGIN
  345.     TextColor(blue);
  346.     GotoXY(vX, vY); Write(#176#176#176);
  347.     GotoXY(vX, succ(vY)); Write(#176#176#176);
  348.       END;
  349.     TextAttr := HoldAttr;
  350.   END;
  351.  
  352.   PROCEDURE LCard.HideAt(vX, vY : Word);
  353.   BEGIN
  354.     HoldAttr := TextAttr;
  355.     TextAttr := TableColor;
  356.     GotoXY(vX, vY); Write('   ');
  357.     GotoXY(vX, succ(vY)); Write('   ');
  358.     TextAttr := HoldAttr;
  359.   END;
  360.  
  361. (*-methods for PILE----------*)
  362.  
  363.   CONSTRUCTOR Pile.Init(iX, iY : Word; iShow : decision); 
  364.   BEGIN
  365.     X := iX; Y := iY; Cards.Init; NumInPile := 0; FaceUp := iShow;
  366.   END;
  367.  
  368.   DESTRUCTOR Pile.Done;
  369.   BEGIN Cards.Done; END;
  370.  
  371.   PROCEDURE Pile.AddCard(C : CardP);
  372.   BEGIN
  373.     IF FaceUp = yes THEN C^.TurnUp;
  374.     IF FaceUP = no  THEN C^.TurnDown;
  375.     Cards.Append(C); Inc(NumInPile);
  376.   END;
  377.  
  378.   PROCEDURE Pile.Display;
  379.   BEGIN IF NOT cards.Empty THEN CardP(cards.last)^.DrawAt(X, Y); END;
  380.  
  381.   PROCEDURE Pile.Hide;
  382.   BEGIN IF NOT cards.Empty THEN CardP(cards.last)^.HideAt(X, Y); END;
  383.  
  384.   PROCEDURE Pile.Sort(bySuit : boolean); 
  385.   VAR
  386.     N, M, T : CardP; 
  387.  
  388.     FUNCTION greater(xM, xN : CardP) : Boolean; 
  389.     VAR Sm, Sn, Rm, Rn : Byte; 
  390.     BEGIN
  391.       Sm := xM^.GetSuit; 
  392.       Sn := xN^.GetSuit; 
  393.       Rm := xM^.GetRank; 
  394.       Rn := xN^.GetRank; 
  395.       greater := false; 
  396.       IF BySuit THEN
  397.         BEGIN
  398.           IF Sm>Sn THEN greater := true
  399.           ELSE IF (Sm = Sn) AND (Rm>Rn) THEN greater := true; 
  400.         END
  401.       ELSE
  402.         BEGIN
  403.           IF Rm > Rn THEN greater := true
  404.           ELSE IF (Rm = Rn) AND (Sm>Sn) THEN greater := true;
  405.         END;
  406.     END;
  407.  
  408.   BEGIN {immediate exchange selection sort}
  409.     N := OnTop;
  410.     WHILE N <> OnBot DO
  411.       BEGIN
  412.         M := OnBot;
  413.         WHILE M <> N DO
  414.           BEGIN
  415.             IF Greater(M, N) THEN
  416.               BEGIN
  417.                 Cards.SwapInList(M, N);
  418.                 T := M; M := N; N := T;
  419.               END;
  420.             M := NextCard(M);
  421.           END;
  422.         N := PrevCard(N);
  423.       END;
  424.   END;
  425.  
  426.   PROCEDURE Pile.PlaceAt(iX, iY : Word); BEGIN X := iX; Y := iY; END;
  427.  
  428.   FUNCTION Pile.OnTop : CardP; BEGIN OnTop := CardP(Cards.Last); END;
  429.  
  430.   FUNCTION Pile.OnBot : CardP; BEGIN OnBot := CardP(Cards.Firs); END;
  431.  
  432.   FUNCTION Pile.FromTop : CardP;
  433.   BEGIN
  434.     IF (NumInPile = 1) AND (X+Y>0) THEN
  435.       CardP(Cards.Last)^.HideAt(X, Y);
  436.     FromTop := CardP(Cards.Last);
  437.     Cards.remove(Cards.Last); Dec(NumInPile);
  438.   END;
  439.  
  440.   FUNCTION Pile.FromBot : CardP;
  441.   BEGIN
  442.     IF (NumInPile = 1) AND (X+Y>0) THEN
  443.       CardP(Cards.Last)^.HideAt(X, Y);
  444.     FromBot := CardP(Cards.Firs);
  445.     Cards.Remove(Cards.Firs); Dec(NumInPile);
  446.   END;
  447.  
  448.   FUNCTION Pile.GetX : Word; BEGIN GetX := X; END;
  449.  
  450.   FUNCTION Pile.GetY : Word; BEGIN GetY := Y; END;
  451.  
  452.   FUNCTION Pile.Empty : boolean; BEGIN Empty := cards.empty; END;
  453.  
  454.   FUNCTION Pile.NextCard(C : CardP) : CardP;
  455.   BEGIN NextCard := CardP(cards.Next(C)); END;
  456.  
  457.   FUNCTION Pile.PrevCard(C : CardP) : CardP; 
  458.   BEGIN PrevCard := CardP(cards.Prev(C)); END; 
  459.  
  460.   PROCEDURE Pile.Remove(C : CardP);
  461.   BEGIN
  462.     IF (NumInPile = 1) AND (X+Y>0) THEN
  463.       CardP(Cards.Last)^.HideAt(X, Y);
  464.     cards.remove(C); Dec(NumInPile);
  465.   END;
  466.  
  467.   PROCEDURE Pile.TurnUp; BEGIN FaceUp := yes; END;
  468.  
  469.   PROCEDURE Pile.TurnDown; BEGIN FaceUp := no; END;
  470.  
  471.   FUNCTION Pile.GetUp : decision; BEGIN GetUp := FaceUp; END;
  472.  
  473. (*-methods for HAND----------*)
  474.  
  475.     CONSTRUCTOR hand.Init(iX, iY : Word; iShow : decision;
  476.                           iDire : direction);
  477.     BEGIN Pile.Init(iX, iY, iShow); direc := iDire; END;
  478.  
  479.     DESTRUCTOR Hand.Done; BEGIN Pile.done; END;
  480.  
  481.     PROCEDURE Hand.Private_Go;
  482.     BEGIN
  483.       CASE direc OF
  484.         up : Dec(pY, 2);
  485.         dn : Inc(pY, 2);
  486.         lt : Dec(pX, 2);
  487.         rt : Inc(pX, 2);
  488.       END; 
  489.     END; 
  490.  
  491.     PROCEDURE Hand.Display;
  492.     VAR C : CardP; 
  493.     BEGIN
  494.       pX := X; pY := Y; C := CardP(cards.Firs); 
  495.       WHILE C <> NIL DO
  496.         BEGIN
  497.           C^.DrawAt(pX, pY); Private_Go;
  498.           C := CardP(cards.next(C));
  499.         END;
  500.     END;
  501.  
  502.     PROCEDURE Hand.Hide;
  503.     VAR C : CardP;
  504.     BEGIN
  505.       pX := X; pY := Y; C := CardP(cards.Firs);
  506.       WHILE C <> NIL DO
  507.         BEGIN
  508.           C^.HideAt(pX, pY); Private_Go;
  509.           C := CardP(cards.next(C));
  510.         END;
  511.     END;
  512.  
  513.     PROCEDURE Hand.PointToCard(CP : CardP; dr : direction);
  514.     VAR C : CardP;
  515.     BEGIN
  516.       pX := X; pY := Y; C := CardP(cards.Firs);
  517.       WHILE (C<>NIL) AND (C<>CP) DO
  518.         BEGIN
  519.           C := CardP(cards.next(C)); Private_Go;
  520.         END;
  521.       IF C <> NIL THEN C^.PointTo(pX, pY, dr);
  522.     END;
  523.  
  524.     PROCEDURE Hand.UnPointCard(CP : CardP; dr : direction);
  525.     VAR C : CardP;
  526.     BEGIN
  527.       pX := X; pY := Y; C := CardP(cards.Firs);
  528.       WHILE (C<>NIL) AND (C<>CP) DO
  529.         BEGIN
  530.           C := CardP(cards.next(C)); Private_Go;
  531.         END;
  532.       IF C <> NIL THEN C^.UnPoint(pX, pY, dr);
  533.     END;
  534.  
  535. (*-methods for DECK----------*)
  536.  
  537.   CONSTRUCTOR deck.Init(iX, iY : Word; iTC : Byte); 
  538.   VAR valu : word; 
  539.   BEGIN
  540.     Pile.Init(iX, iY, no); 
  541.     FOR valu := 0 to 51 DO
  542.       AddCard(New(CardP, Init(valu, iTC, false))); 
  543.   END;
  544.  
  545.   DESTRUCTOR Deck.done; BEGIN Pile.Done; END; 
  546.  
  547.   PROCEDURE Deck.Shuffle;
  548.   VAR N,M,T:CardP;
  549.   BEGIN
  550.     N := OnBot;
  551.     WHILE N <> NIL DO
  552.       BEGIN
  553.         M := CardP(Cards.Nth(succ(random(NumInPile))));
  554.         Cards.SwapInList(N, M);
  555.         T := M; M := N; N := T;
  556.         N := NextCard(N);
  557.       END;
  558.   END;
  559.  
  560.   PROCEDURE Deck.AddToBottom(C : CardP);
  561.   BEGIN
  562.     IF FaceUp = yes THEN C^.TurnUp;
  563.     IF FaceUP = no  THEN C^.TurnDown;
  564.     Cards.Insert(cards.Firs, C);
  565.     Inc(NumInPile);
  566.   END;
  567.  
  568. (*-methods for LDECK---------*)
  569.  
  570.   CONSTRUCTOR LDeck.Init(iX, iY : Word; iTC : Byte);
  571.   VAR valu : Word;
  572.   BEGIN
  573.     Pile.Init(iX, iY, no);
  574.     FOR valu := 0 to 51 DO
  575.       AddCard(New(LCardP, Init(valu, iTC, false))); 
  576.   END; 
  577.  
  578.   DESTRUCTOR LDeck.done; BEGIN Deck.Done; END; 
  579.  
  580. (*-methods for Player--------*)
  581.  
  582.   CONSTRUCTOR Player.Init(iX, iY : Word; iShow : decision; 
  583.                           iDire : direction; iName : String); 
  584.   BEGIN New(H, Init(iX, iY, iShow, iDire)); name := iName; END; 
  585.  
  586.   DESTRUCTOR Player.Done; BEGIN dispose(H, done); END; 
  587.  
  588.   PROCEDURE Player.TakeCard(C : CardP); BEGIN H^.AddCard(C); END;
  589.  
  590.   FUNCTION Player.GetName : String; BEGIN GetName := name; END;
  591.  
  592.   {--- abstract methods ---}
  593.   PROCEDURE Player.ShowHand; BEGIN END;
  594.   PROCEDURE Player.PointToMe; BEGIN END;
  595.   PROCEDURE Player.UnPointMe; BEGIN END;
  596.  
  597.   FUNCTION Player.OutOfCards : Boolean;
  598.   BEGIN OutOfCards := H^.empty; END;
  599.  
  600.   FUNCTION Player.NextNotSelf(L : List; X : PlayerP) : PlayerP;
  601.   VAR P : PlayerP;
  602.   BEGIN
  603.     P := PlayerP(L.NextCirc(X));
  604.     IF P = @Self THEN P := PlayerP(L.NextCirc(P));
  605.     NextNotSelf := P;
  606.   END;
  607.  
  608.   FUNCTION Player.PrevNotSelf(L : List; X : PlayerP) : PlayerP;
  609.   VAR P : PlayerP;
  610.   BEGIN
  611.     P := PlayerP(L.PrevCirc(X));
  612.     IF P = @Self THEN P := PlayerP(L.PrevCirc(P));
  613.     PrevNotSelf := P;
  614.   END;
  615.  
  616.   FUNCTION Player.FirsNotSelf(L : List) : PlayerP;
  617.   BEGIN
  618.     IF L.Firs = @Self THEN
  619.       FirsNotSelf := PlayerP(L.NextCirc(L.firs))
  620.     ELSE FirsNotSelf := PlayerP(L.Firs);
  621.   END;
  622.  
  623. (*-methods for GAME----------*)
  624.  
  625.   CONSTRUCTOR game.Init(iTC : Byte);
  626.   BEGIN
  627.     Randomize;
  628.     TableColor := iTC;
  629.     players.Init; whoseturn := NIL;
  630.     {each game inits its own DECK}
  631.   END;
  632.  
  633.   DESTRUCTOR game.done; BEGIN Players.done; dispose(D, done); END;
  634.  
  635.   PROCEDURE game.AddPlayer(PP : PlayerP);
  636.   BEGIN
  637.     players.append(PP);
  638.     IF players.Firs = players.last THEN
  639.       WhoseTurn := PlayerP(players.Firs);
  640.   END;
  641.  
  642.   PROCEDURE game.DealCards(num : word);
  643.   VAR N : byte;
  644.     P : PlayerP;
  645.   BEGIN
  646.     IF num = 0 THEN {deal 'til deck is gone}
  647.       BEGIN
  648.         P := PlayerP(players.Firs);
  649.         WHILE NOT D^.empty DO
  650.           BEGIN
  651.             P^.TakeCard(D^.FromTop);
  652.             P := PlayerP(players.NextCirc(P));
  653.           END;
  654.       END
  655.     ELSE {deal "num" cards to each player}
  656.       FOR N := 1 to num DO
  657.         BEGIN
  658.           P := PlayerP(players.Firs);
  659.           WHILE P <> NIL DO
  660.             BEGIN
  661.               P^.TakeCard(D^.FromTop); 
  662.               P := PlayerP(players.next(P));
  663.             END; 
  664.         END; 
  665.   END; 
  666.  
  667.   PROCEDURE game.Display; BEGIN END;
  668.  
  669. END.
  670.